library(cluster)
library(flexmix)
library(arulesSequences)

intvl_threshold <- 30*60
rev_intvl_threshold <- -intvl_threshold

f_sample_size <- 1000
p_sample_size <- 200

tr_info_names <- c('sequenceID', 'eventID')
actions <- c('b', 'p', 'r', 's')
sp_param <- list(support=0.5, maxgap=intvl_threshold)

read <- function(filename, sep=',', header=NULL) {
    ifelse(is.null(header), file <- read.csv(filename, header=TRUE, sep=sep), file <- read.csv(filename, header=FALSE, sep=sep, col.names=header))
    return(file)
}

intvl_sum <- function(time) {
    intvl = c(Inf, diff(time))
    return(sum(intvl[intvl<intvl_threshold])/60)
}

duration <- function(data) {
    dur <- tapply(data$time, INDEX=data$user_id, FUN=intvl_sum)
    return(dur)
}

median_duration <- function(data) {
    dur <- duration(data)
    return(median(dur))
}

pos_action_ratio_kernal <- function(action) {
    action_table <- table(action)
    play <- action_table['p']
    heart <- action_table['r']
    pos_action_ratio <- (play + heart) / sum(action_table)
    return(pos_action_ratio)
}

pos_action_ratio <- function(data) {
    pos_action <- tapply(data$action, INDEX=data$user_id, FUN=pos_action_ratio_kernal)
    pos_action <- pos_action[!is.na(pos_action)]
    pos_action <- pos_action[is.finite(pos_action)]
    return(pos_action)
}

action_avg <- function(data) {
    action_table <- table(data$action)
    action_avg <- action_table / nlevels(factor(data$user_id))
    return(action_avg)
}

action_ratio <- function(data) {
    action_table <- table(data$action)
    action_ratio <- action_table / sum(action_table)
    return(action_ratio)
}

gompertz <- function(x) {
    a <- 2
    b <- log(0.5)
    c <- -0.0887809
    y <- a * exp(b * exp(c * x))
    return(y)
}

sat_kernal <- function(action) {
    c_play <- -0.0887809
    c_skip <- -0.153276
    alpha <- function(x) (2 - 2*exp(log(0.5)*exp(c_play*x)))
    beta <- function(x) 2*exp(log(0.5)*exp(c_skip*x))
    gamma <- 10
    action_table <- table(action)
    play <- action_table['p']
    skip <- action_table['s']
    heart <- action_table['r']
    ban <- action_table['b']
    sat <- (alpha(play)*play + gamma*heart - (beta(skip)*skip + gamma*ban)) / length(action)
    return(sat)
}

satisfaction <- function(data) {
    sat <- tapply(data$action, INDEX=data$user_id, FUN=sat_kernal)
    sat <- sat[!is.na(sat)]
    sat <- sat[is.finite(sat)]
    return(sat)
}

filter <- function(data, low_bound) {
    count <- table(data$user_id)
    data$count <- count[as.character(data$user_id)]
    eff_data <- data[data$count>=low_bound,]
    eff_data$count <- NULL
    return(eff_data)
}

freq_distr <- function(data, sample_size=f_sample_size) {
    breaks <- seq(from=min(data), to=max(data), length=sample_size+1)
    fac <- factor(cut(data, breaks=breaks, label=FALSE, include.lowest=TRUE))
    freq <- table(fac)
    fd <- data.frame(index=c(1:sample_size))
    fd$breaks <- breaks[2:(sample_size+1)]
    fd$freq <- ifelse(is.na(freq[as.character(fd$index)]), 0, freq[as.character(fd$index)])
    return(fd)
}

prob_distr <- function(data, sample_size=p_sample_size) {
    fd <- freq_distr(data, sample_size)
    result <- fd$freq/length(data)
    return(unname(result))
}

KLdiv_analyse <- function(data) {
    data <- as(data, 'matrix')
    pd_data <- apply(data, MARGIN=2, FUN=prob_distr)
    result <- KLdiv(pd_data)
    return(result)
}

cor_analyse <- function(data) {
   result <- cor(data, data)
   return(result)
}

seq_mining <- function(data, tr_filename, param=sp_param) {
    transaction <- data.frame(sequenceID=as.factor(data$user_id), eventID=data$time, item=data$action)
    transaction <- transaction[order(transaction$sequenceID, transaction$eventID),]
    
    write.table(transaction, file=tr_filename, quote=FALSE, sep='\t', row.names=FALSE, col.names=FALSE)
    transaction <- read_baskets(con=tr_filename, info=tr_info_names)
    
    result <- cspade(transaction, parameter=param)

    return(as(result, 'data.frame'))
}

clustering <- function(data, nclust) {
    data <- data[complete.cases(data),]
    data <- as.matrix(data)
    result <- kmeans(t(scale(t(data))), 3)
    clusplot(data, result$cluster, color=TRUE, shade=TRUE, labels=0, lines=0)
    return(result)
}
